Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/tbbs/prgsourc.zip/CD-MGR.ZIP/CD_MGR.PRG

Text File | 1996-03-07 | 13KB | 490 lines

SET ESCAPE OFF
SET FORMAT TO fscr NOCLEAR
SET INTENSITY OFF

DO Screen

USE cdrom INDEX cdr
COUNT TO end
GOTO TOP

DECLARE cdrom[end]

cd = 1
DO WHILE cd < end
   cdrom[cd] = title
   cd = cd + 1
   SKIP
ENDDO
cdrom[cd] = title

tPag = Ceiling(end/17)                   && Total pages
cd = 1                                   && Current CD-ROM
pag = 1                                  && Current page
row = 3                                  && Current row

DO List

SET COLOR TO GR+/B
@ row,16 SAY cdrom[cd]

SET COLOR TO N/N
kin = " "
@ 2,0 GET kin
DO WHILE .T.
   READ
   DO CASE
      CASE LastKey() = 3                         && <Page Down>
           IF cd = end
              LOOP
           ENDIF
           IF pag = tPag
              SET COLOR TO W+/N
              @ row,16 SAY cdrom[cd]
              row = row + (end - cd)
              cd = end
           ELSE
              IF (cd + 17) > end
                 row = row - ((cd + 17) - end)
                 cd = end
              ELSE
                 cd = cd + 17
              ENDIF
              pag = pag + 1
              DO List
           ENDIF

      CASE LastKey() = 5                         && Up Arrow
           IF cd = 1
              LOOP
           ENDIF
           IF row = 3
              cd = cd - 1
              pag = pag - 1
              DO List
              row = 19
           ELSE
              SET COLOR TO W+/N
              @ row,16 SAY cdrom[cd]
              row = row - 1
              cd = cd - 1
           ENDIF

      CASE LastKey() = 13                          && <Enter>
           SEEK cdrom[cd]
           DO Edit WITH .F.
           RELEASE cdrom
           COUNT TO end
           GOTO TOP
           DECLARE cdrom[end]
           cd = 1
           DO WHILE cd < end
              cdrom[cd] = title
              cd = cd + 1
              SKIP
           ENDDO
           cdrom[cd] = title
           tPag = Ceiling(end/17)
           cd = 1
           pag = 1
           row = 3
           DO Screen
           DO List

      CASE LastKey() = 18                        && <Page Up>
           IF cd = 1
              LOOP
           ENDIF
           IF pag = 1
              SET COLOR TO W+/N
              @ row,16 SAY cdrom[cd]
              row = row - (cd - 1)
              cd = 1
           ELSE
              cd = cd - 17
              pag = pag - 1
              DO List
           ENDIF

      CASE LastKey() = 24                        && Down Arrow
           IF cd = end
              LOOP
           ENDIF
           IF row = 19
              cd = cd + 1
              pag = pag + 1
              DO List
              row = 3
           ELSE
              SET COLOR TO W+/N
              @ row,16 SAY cdrom[cd]
              row = row + 1
              cd = cd + 1
           ENDIF

      CASE LastKey() = 27                   && <Esc>
           GOTO TOP
           x = 1
           t = 0
           DO WHILE .T.
              IF online
                 t = t + 1
              ENDIF
              IF x = end
                 EXIT
              ENDIF
              SKIP
              x = x + 1
           ENDDO
           DO BoxW WITH 9,13,12,54,"s+"
           IF t = 1
              @ 10,15 SAY "You have " + LTrim(Str(t)) + " CD-ROM marked as On-line"
           ELSE
              @ 10,15 SAY "You have " + LTrim(Str(t)) + " CD-ROMs marked as On-line"
           ENDIF
           @ 11,15 SAY "Is this correct?"
           key = InKey(30)
           IF key = 89 .OR. key = 121
              DO BoxW WITH 7,12,16,54,"as+"
              @ 8,23 SAY         "CD-ROM Manager s1.0"
              @ 10,16 SAY "Copyright 1996, Darryl Kerkeslager"
              @ 11,18 SAY   "LocalNet BBS, [phone]"
              @ 13,19 SAY    "Please register - only $7"
              key = InKey(40)
              QUIT
           ELSE
              DO List
           ENDIF

      CASE LastKey() = 65 .OR. LastKey() = 97    && A or a: Add
           IF end = 100
              DO BoxW WITH 8,23,14,55,"sa+"
              @ 9,25 SAY  "For efficency, the program"
              @ 10,25 SAY "is limited to 100 CD-ROMs. No"
              @ 11,25 SAY "more CD-ROMs can be added."
              key = InKey(40)
              SET COLOR TO N/N
              @ 8,23 CLEAR TO 15,56
              DO List
           ENDIF

           APPEND BLANK
           REPLACE title WITH "Bogus CD-ROM, 1996, LocalNet BBS"
           REPLACE path WITH "C:\CDROM\BOGUS\"
           REPLACE farfile WITH "BOGUS"
           REPLACE listfile WITH "BOGUS_CD.ZIP"
           REPLACE odata WITH "/D/F/AS/Z2/Y"

           DO Edit WITH .T.
           DO Screen

           RELEASE cdrom
           COUNT TO end
           GOTO TOP
           DECLARE cdrom[end]
           cd = 1
           DO WHILE cd < end
              cdrom[cd] = title
              cd = cd + 1
              SKIP
           ENDDO
           cdrom[cd] = title
           tPag = Ceiling(end/17)
           cd = 1
           pag = 1
           row = 3

           DO List

      CASE LastKey() = 68 .OR. LastKey() = 100   && D or d: Delete
           SEEK cdrom[cd]
           DELETE
           DO List

      CASE LastKey() = 82 .OR. LastKey() = 114   && R or r: Recall
           SEEK cdrom[cd]
           RECALL
           REPLACE acc WITH 0
           REPLACE zip WITH 0
           DO Edit WITH .F.
           DO Screen
           DO List

   ENDCASE
   SET COLOR TO GR+/B
   @ row,16 SAY cdrom[cd]
ENDDO
RETURN

**************************************************
PROCEDURE List

PRIVATE row
row = 3
n = Int((pag-1)*17) + 1

SET COLOR TO N/N
@ 2,0 CLEAR TO 20,79

DO WHILE row <= 19
         SEEK cdrom[n]

         SET COLOR TO GR+/N
         @ row,1 SAY "["
         @ row,2 SAY n PICTURE "@Z 99"
         @ row,4 SAY "]"
         IF online
            SET COLOR TO G+/N
            @ row,6 SAY "On-Line "
         ELSE
            SET COLOR TO R+/N
            @ row,6 SAY date
         ENDIF
         SET COLOR TO W+/N
         @ row,16 SAY title
         SET COLOR TO GR+/N
         IF Deleted()
            @ row,58 SAY "<<<  DELETED  >>>"
         ELSE
            @ row,58 SAY acc PICTURE "@ 9999"
            @ row,71 SAY zip PICTURE "@ 9999"
         ENDIF
         IF n = end
            EXIT
         ENDIF
         row = row + 1
         n = n + 1
ENDDO
RETURN

**************************************************
PROCEDURE Screen

SET COLOR TO N/N
@ 0,0 CLEAR
SET COLOR TO R/R
@ 0,0 CLEAR TO 1,79
@ 21,0 CLEAR TO 23,79
SET COLOR TO GR+/R
@ 0,3 SAY "CD-ROM Manager"
@ 21,3 SAY  "Cursor keys"
@ 21,51 SAY "A"
@ 22,7 SAY  "<Enter>"
@ 22,51 SAY "D"
@ 23,9 SAY  "<Esc>"
@ 23,51 SAY "R"
SET COLOR TO W+/R
@ 0,57 SAY ".FAR         .ZIP"
@ 1,6 SAY "On-line                   Title                    Entered     Downloads"
@ 21,15 SAY "= Move Highlite"
@ 21,53 SAY "= Add new CD-ROM"
@ 22,15 SAY "= Edit highlited CD-ROM entry"
@ 22,53 SAY "= Delete CD-ROM"
@ 23,15 SAY "= Quit"
@ 23,53 SAY "= Recall/Undelete"
RETURN



**************************************************
PROCEDURE Edit
PARAMETERS add

SET FORMAT TO fget NOCLEAR
r = 1
DO WHILE .T.
   DO BoxW WITH 1,17,20,62,"s+"

   @ 2,30 SAY  "CD-ROM Entry/Edit"
   @ 4,19 SAY  "Title (including year and company)"
   @ 7,19 SAY  "Drive:\path\ to .FAR and .ZIP"
   @ 10,19 SAY ".FAR file (no extension)"
   @ 11,31 SAY "OptData"
   @ 13,19 SAY "Listing file (add .ZIP extension)"
   @ 16,19 SAY "Next Date On-line"
   @ 17,19 SAY "On-line ?"
   @ 19,19 SAY "<Page Up>                       <ESC>"
   SET COLOR TO W+/W
   @ 5,19 SAY  "[                                        ]"
   @ 8,19 SAY  "[                              ]"
   @ 11,19 SAY "[        ]"
   @ 11,39 SAY "[                    ]"
   @ 14,19 SAY "[            ]"
   @ 16,37 SAY "[        ]"
   @ 17,29 SAY "[ ]"
   @ 19,29 SAY "Save and Exit"
   @ 19,57 SAY "Exit"

   DO CASE
      CASE r = 1
           READ
      CASE r = 2
           READ SELECT farfile
      CASE r = 3
           READ SELECT listfile
      CASE r = 4
           READ SELECT odata
   ENDCASE

   DO WHILE .T.
      DO CASE
         CASE LastKey() = 27   && <Esc>
              IF add
                 t = title
                 REPLACE title WITH "TEMP"
                 SEEK t
                 IF Found()
                    DO toErr WITH 53,"CD-ROM must have a unique name."
                    SEEK "TEMP"
                    REPLACE title WITH t
                    r = 1
                    ok = .F.
                    EXIT
                 ELSE
                    SEEK "TEMP"
                    REPLACE title WITH t
                    DELETE
                    SET FORMAT TO fscr NOCLEAR
                    RETURN
                 ENDIF
              ENDIF
              EXIT
         CASE LastKey() = 18   && <Page Up>
              EXIT
         OTHERWISE
              READ
      ENDCASE
   ENDDO

   t = title
   REPLACE title WITH "TEMP"
   SEEK t
   IF Found()
      DO toErr WITH 53,"CD-ROM must have a unique name."
      SEEK "TEMP"
      REPLACE title WITH t
      r = 1
      LOOP
   ELSE
      SEEK "TEMP"
      REPLACE title WITH t
   ENDIF

   IF rAt("\",RTrim(path)) # Len(RTrim(path))
      REPLACE path WITH RTrim(path) + "\"
   ENDIF

   IF "." $ farfile
      DO toErr WITH 52,"Do not include .FAR extension."
      r = 2
      LOOP
   ENDIF

   IF .NOT. ".ZIP" $ listfile
      DO toErr WITH 57,"List file must have .ZIP extension."
      r = 3
      LOOP
   ENDIF

   IF "\" $ odata
     DO toErr WITH 54,"Opt Data format incorrect: use /"
     r = 4
     LOOP
   ENDIF

   IF "/U" $ odata
     DO toErr WITH 60,"Cannot upload to CD-ROM: cannot use /U"
     r = 4
     LOOP
   ENDIF

   IF .NOT. File(RTrim(path) + RTrim(farfile) + ".FAR")
      DO toErr WITH 42,".FAR file not found."
      r = 2
      LOOP
   ENDIF

   IF .NOT. File(RTrim(path) + RTrim(listfile))
      DO toErr WITH 42,"List file not found."
      r = 3
      LOOP
   ENDIF

   EXIT
ENDDO
SET FORMAT TO fscr NOCLEAR
RETURN

**************************************************
PROCEDURE BoxW
PARAMETERS x,y,n,c,s

SET COLOR TO W/W
@ x,y CLEAR TO n,c
IF "s" $ s
  SET COLOR TO N/N
  @ n+1,y+1 CLEAR TO n+1,c
  @ x+1,c+1 CLEAR TO n+1,c+1
ENDIF
SET COLOR TO N/W
IF "+" $ s
  SET COLOR TO W+/W
ENDIF
@ x,y SAY "┌"
@ x,y+1 TO x,c
@ x,c SAY "┐"
@ x+1,y TO n,y
@ n,y SAY "└"
IF "a" $ s
  SET COLOR TO W+/W
  @ n-1,Ceiling((c-y-11)/2)+y SAY "< ANY KEY >"
ENDIF
SET COLOR TO N/W
@ x+1,c TO n,c
@ n,y+1 TO n,c
@ n,c SAY "┘"
RETURN


**************************************************
PROCEDURE BoxB
PARAMETERS x,y,n,c,s

SET COLOR TO B/B
@ x,y CLEAR TO n,c
IF "s" $ s
  SET COLOR TO N/N
  @ n+1,y+1 CLEAR TO n+1,c
  @ x+1,c+1 CLEAR TO n+1,c+1
ENDIF
SET COLOR TO N/B
IF "+" $ s
  SET COLOR TO W+/B
ENDIF
@ x,y SAY "┌"
@ x,y+1 TO x,c
@ x,c SAY "┐"
@ x+1,y TO n,y
@ n,y SAY "└"
IF "a" $ s
  SET COLOR TO W+/B
  @ n-1,Ceiling((c-y-11)/2)+y SAY "< ANY KEY >"
ENDIF
SET COLOR TO N/B
@ x+1,c TO n,c
@ n,y+1 TO n,c
@ n,c SAY "┘"
SET COLOR TO W+/B
RETURN

**************************************************
PROCEDURE toErr
PARAMETERS z,c

DO BoxB WITH 10,19,13,z,"sa+"
@ 11,21 SAY c
key = InKey(40)

RETURN